---
title: "Report"
date: "`r Sys.Date()`"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: menu
source_code: embed
---
```{r setup, include=FALSE}
## Global options
library(reticulate)
library(knitr)
library(flexdashboard)
library(scales)
library(here)
library(tidyverse)
library(readr)
library(plotly)
library(tidyverse)
knitr::opts_chunk$set(cache = TRUE)
source(here('modules','data_funcs.R'))
# PARAMS
warm <- 250
dur <- 1000
repl <- 30
path <- here('data','full-sm')
# NO CUU - OR * 1
modif <- '0-1'
dt_pl_n10 <- generate_summary(path, modif, dur, warm, repl)
dt_sa_n10 <- generate_summary_sa(path, modif, dur, warm, repl)
dt_zs_n10 <- generate_summary_zs(path, modif, FALSE)
# NO CUU - OR * 1.1
modif <- '0-1.1'
dt_pl_n11 <- generate_summary(path, modif, dur, warm, repl)
dt_sa_n11 <- generate_summary_sa(path, modif, dur, warm, repl)
dt_zs_n11 <- generate_summary_zs(path, modif, FALSE)
# NO CUU - OR * 1.2
modif <- '0-1.2'
dt_pl_n12 <- generate_summary(path, modif, dur, warm, repl)
dt_sa_n12 <- generate_summary_sa(path, modif, dur, warm, repl)
dt_zs_n12 <- generate_summary_zs(path, modif, FALSE)
# NO CUU - OR * 1.3
modif <- '0-1.3'
dt_pl_n13 <- generate_summary(path, modif, dur, warm, repl)
dt_sa_n13 <- generate_summary_sa(path, modif, dur, warm, repl)
dt_zs_n13 <- generate_summary_zs(path, modif, FALSE)
# CUU - OR * 1
modif <- '1000-1'
dt_pl_y10 <- generate_summary(path, modif, dur, warm, repl)
dt_sa_y10 <- generate_summary_sa(path, modif, dur, warm, repl)
dt_zs_y10 <- generate_summary_zs(path, modif, TRUE)
# CUU - OR * 1.1
modif <- '1000-1.1'
dt_pl_y11 <- generate_summary(path, modif, dur, warm, repl)
dt_sa_y11 <- generate_summary_sa(path, modif, dur, warm, repl)
dt_zs_y11 <- generate_summary_zs(path, modif, TRUE)
# CUU - OR * 1.2
modif <- '1000-1.2'
dt_pl_y12 <- generate_summary(path, modif, dur, warm, repl)
dt_sa_y12 <- generate_summary_sa(path, modif, dur, warm, repl)
dt_zs_y12 <- generate_summary_zs(path, modif, TRUE)
# CUU - OR * 1.3
modif <- '1000-1.3'
dt_pl_y13 <- generate_summary(path, modif, dur, warm, repl)
dt_sa_y13 <- generate_summary_sa(path, modif, dur, warm, repl)
dt_zs_y13 <- generate_summary_zs(path, modif, TRUE)
# MODEL DATA SUMMARY
arrival_rate <- data.frame(
Surgery = c('Surgery 1', 'Surgery 1', 'Surgery 4',
'Surgery 4', 'Surgery 6', 'Surgery 6'),
Complexity = c('Complexity 1', 'Complexity 2', 'Complexity 1',
'Complexity 2', 'Complexity 1', 'Complexity 2'),
"Arrival_Adjusted" = c(1.23, 0.62, 0.14, 0.10, 1.23, 0.62),
"Arrival_Original" = c(1, 0.5, 0.0833, 0.0625, 1, 0.5),
Rationale = c("once per week", "once per two weeks", "once per 3 months",
"once per 4 months", "once per week", "once per 2 weeks")
)
resource_usage <- data.frame(
Surgery = c('Surgery 1', 'Surgery 1', 'Surgery 1', 'Surgery 1',
'Surgery 4', 'Surgery 4', 'Surgery 4', 'Surgery 4',
'Surgery 6', 'Surgery 6', 'Surgery 6', 'Surgery 6'),
Complexity = c('Complexity 1', 'Complexity 1', 'Complexity 2',
'Complexity 2', 'Complexity 1', 'Complexity 1',
'Complexity 2', 'Complexity 2', 'Complexity 1',
'Complexity 1', 'Complexity 2', 'Complexity 2'),
Resource_Type = c('Admissions', 'OR_Time','Admissions', 'OR_Time',
'Admissions', 'OR_Time','Admissions', 'OR_Time',
'Admissions', 'OR_Time','Admissions', 'OR_Time'),
Usage = c(0,3,1,4,1,4,1,5.5,0,1.5,0,2.5)
)
resource_capacity <- data.frame(
Resouce = c('Admissions', 'OR_Time'),
Capacity_Weekly = c(1.5, 11.25),
Unit = c("Patients Admitted per week", "OR Hours per week")
)
```
Model Parameters
=======================================================================
Row
-----------------------------------------------------------------------
### Model Parameters
**Model Instance**
* Planning horizon is decreased from 24 weeks to 10 weeks
* Maximum tracked wait is decreased from 6 weeks to 4 weeks
* There are 3 surgeries instead of 6 surgeries
* Number of priorities is set to 1
**Simulation Parameters**
* 30 Replications
* 1000 weeks duration
* 250 weeks warm up
**Surgeries**
* Surgery 1 - 1. SPINE POSTERIOR DECOMPRESSION/LAMINECTOMY LUMBAR
* Surgery 4 - 4. SPINE POST CERV DECOMPRESSION AND FUSION W INSTR
* Surgery 6 - 6. SPINE POSTERIOR DISCECTOMY LUMBAR
### Arrival Rate
It was set to be 95% of the capacity, however due to transitions, the resource usage should be higher than 95%
``` {r echo=FALSE, cache=FALSE}
kable(arrival_rate)
```
Row
-----------------------------------------------------------------------
### Resource Usage
```{r echo=FALSE, cache=FALSE}
kable(resource_usage)
```
### Resource Capacity
```{r echo=FALSE, cache=FALSE}
kable(resource_capacity)
```
NP, 1
=======================================================================
Row {data-height=650}
-----------------------------------------------------------------------
### Policy Description
The policy description is based on a graph to the right
* The left column shows MDP policy, the right column shows Myopic Policy
* The top row shows scheduling costs, adjusted for resource usage, the bottom is not adjusted
* The bottom row shows in which days the policy will allow scheduling.
* The top row shows approximate order of patient scheduling.
Additionally the far right graph shows the approximate decision making
### Policy Math Graph
```{r echo=FALSE}
dt_zs_n10$zf_plt %>% ggplotly()
```
### Policy Evidence Graph
```{r echo=FALSE}
dt_sa_n10$res_plot$sched_plt %>% ggplotly()
```
Row
-----------------------------------------------------------------------
### Wait Times in weeks
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n10$results$pw)
```
### Wait List Size
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n10$results$wtl)
```
### Transitions per week
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n10$results$tr)
```
### Utilization
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n10$results$util)
```
Row
-----------------------------------------------------------------------
### Reschedules
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n10$results$rsc)
```
### Wait List Size by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_n10$res_plot$waitlist_plt %>% ggplotly()
```
### Reschedules by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_n10$res_plot$rsc_plt %>% ggplotly()
```
NP, 1.1
=======================================================================
Row {data-height=650}
-----------------------------------------------------------------------
### Policy Description
The policy description is based on a graph to the right
* The left column shows MDP policy, the right column shows Myopic Policy
* The top row shows scheduling costs, adjusted for resource usage, the bottom is not adjusted
* The bottom row shows in which days the policy will allow scheduling.
* The top row shows approximate order of patient scheduling.
Additionally the far right graph shows the approximate decision making
### Policy Math Graph
```{r echo=FALSE}
dt_zs_n11$zf_plt %>% ggplotly()
```
### Policy Evidence Graph
```{r echo=FALSE}
dt_sa_n11$res_plot$sched_plt %>% ggplotly()
```
Row
-----------------------------------------------------------------------
### Wait Times in weeks
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n11$results$pw)
```
### Wait List Size
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n11$results$wtl)
```
### Transitions per week
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n11$results$tr)
```
### Utilization
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n11$results$util)
```
Row
-----------------------------------------------------------------------
### Reschedules
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n11$results$rsc)
```
### Wait List Size by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_n11$res_plot$waitlist_plt %>% ggplotly()
```
### Reschedules by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_n11$res_plot$rsc_plt %>% ggplotly()
```
NP, 1.2
=======================================================================
Row {data-height=650}
-----------------------------------------------------------------------
### Policy Description
The policy description is based on a graph to the right
* The left column shows MDP policy, the right column shows Myopic Policy
* The top row shows scheduling costs, adjusted for resource usage, the bottom is not adjusted
* The bottom row shows in which days the policy will allow scheduling.
* The top row shows approximate order of patient scheduling.
Additionally the far right graph shows the approximate decision making
### Policy Math Graph
```{r echo=FALSE}
dt_zs_n12$zf_plt %>% ggplotly()
```
### Policy Evidence Graph
```{r echo=FALSE}
dt_sa_n12$res_plot$sched_plt %>% ggplotly()
```
Row
-----------------------------------------------------------------------
### Wait Times in weeks
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n12$results$pw)
```
### Wait List Size
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n12$results$wtl)
```
### Transitions per week
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n12$results$tr)
```
### Utilization
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n12$results$util)
```
Row
-----------------------------------------------------------------------
### Reschedules
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n12$results$rsc)
```
### Wait List Size by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_n12$res_plot$waitlist_plt %>% ggplotly()
```
### Reschedules by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_n12$res_plot$rsc_plt %>% ggplotly()
```
NP, 1.3
=======================================================================
Row {data-height=650}
-----------------------------------------------------------------------
### Policy Description
The policy description is based on a graph to the right
* The left column shows MDP policy, the right column shows Myopic Policy
* The top row shows scheduling costs, adjusted for resource usage, the bottom is not adjusted
* The bottom row shows in which days the policy will allow scheduling.
* The top row shows approximate order of patient scheduling.
Additionally the far right graph shows the approximate decision making
### Policy Math Graph
```{r echo=FALSE}
dt_zs_n13$zf_plt %>% ggplotly()
```
### Policy Evidence Graph
```{r echo=FALSE}
dt_sa_n13$res_plot$sched_plt %>% ggplotly()
```
Row
-----------------------------------------------------------------------
### Wait Times in weeks
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n13$results$pw)
```
### Wait List Size
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n13$results$wtl)
```
### Transitions per week
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n13$results$tr)
```
### Utilization
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n13$results$util)
```
Row
-----------------------------------------------------------------------
### Reschedules
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_n13$results$rsc)
```
### Wait List Size by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_n13$res_plot$waitlist_plt %>% ggplotly()
```
### Reschedules by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_n13$res_plot$rsc_plt %>% ggplotly()
```
P, 1
=======================================================================
Row {data-height=650}
-----------------------------------------------------------------------
### Policy Description
The policy description is based on a graph to the right
* The left column shows MDP policy, the right column shows Myopic Policy
* The top row shows scheduling costs, adjusted for resource usage, the bottom is not adjusted
* The bottom row shows in which days the policy will allow scheduling.
* The top row shows approximate order of patient scheduling.
Additionally the far right graph shows the approximate decision making
### Policy Math Graph
```{r echo=FALSE}
dt_zs_y10$zf_plt %>% ggplotly()
```
### Policy Evidence Graph
```{r echo=FALSE}
dt_sa_y10$res_plot$sched_plt %>% ggplotly()
```
Row
-----------------------------------------------------------------------
### Wait Times in weeks
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y10$results$pw)
```
### Wait List Size
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y10$results$wtl)
```
### Transitions per week
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y10$results$tr)
```
### Utilization
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y10$results$util)
```
Row
-----------------------------------------------------------------------
### Reschedules
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y10$results$rsc)
```
### Wait List Size by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_y10$res_plot$waitlist_plt %>% ggplotly()
```
### Reschedules by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_y10$res_plot$rsc_plt %>% ggplotly()
```
P, 1.1
=======================================================================
Row {data-height=650}
-----------------------------------------------------------------------
### Policy Description
The policy description is based on a graph to the right
* The left column shows MDP policy, the right column shows Myopic Policy
* The top row shows scheduling costs, adjusted for resource usage, the bottom is not adjusted
* The bottom row shows in which days the policy will allow scheduling.
* The top row shows approximate order of patient scheduling.
Additionally the far right graph shows the approximate decision making
### Policy Math Graph
```{r echo=FALSE}
dt_zs_y11$zf_plt %>% ggplotly()
```
### Policy Evidence Graph
```{r echo=FALSE}
dt_sa_y11$res_plot$sched_plt %>% ggplotly()
```
Row
-----------------------------------------------------------------------
### Wait Times in weeks
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y11$results$pw)
```
### Wait List Size
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y11$results$wtl)
```
### Transitions per week
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y11$results$tr)
```
### Utilization
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y11$results$util)
```
Row
-----------------------------------------------------------------------
### Reschedules
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y11$results$rsc)
```
### Wait List Size by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_y11$res_plot$waitlist_plt %>% ggplotly()
```
### Reschedules by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_y11$res_plot$rsc_plt %>% ggplotly()
```
P, 1.2
=======================================================================
Row {data-height=650}
-----------------------------------------------------------------------
### Policy Description
The policy description is based on a graph to the right
* The left column shows MDP policy, the right column shows Myopic Policy
* The top row shows scheduling costs, adjusted for resource usage, the bottom is not adjusted
* The bottom row shows in which days the policy will allow scheduling.
* The top row shows approximate order of patient scheduling.
Additionally the far right graph shows the approximate decision making
### Policy Math Graph
```{r echo=FALSE}
dt_zs_y12$zf_plt %>% ggplotly()
```
### Policy Evidence Graph
```{r echo=FALSE}
dt_sa_y12$res_plot$sched_plt %>% ggplotly()
```
Row
-----------------------------------------------------------------------
### Wait Times in weeks
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y12$results$pw)
```
### Wait List Size
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y12$results$wtl)
```
### Transitions per week
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y12$results$tr)
```
### Utilization
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y12$results$util)
```
Row
-----------------------------------------------------------------------
### Reschedules
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y12$results$rsc)
```
### Wait List Size by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_y12$res_plot$waitlist_plt %>% ggplotly()
```
### Reschedules by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_y12$res_plot$rsc_plt %>% ggplotly()
```
P, 1.3
=======================================================================
Row {data-height=650}
-----------------------------------------------------------------------
### Policy Description
The policy description is based on a graph to the right
* The left column shows MDP policy, the right column shows Myopic Policy
* The top row shows scheduling costs, adjusted for resource usage, the bottom is not adjusted
* The bottom row shows in which days the policy will allow scheduling.
* The top row shows approximate order of patient scheduling.
Additionally the far right graph shows the approximate decision making
### Policy Math Graph
```{r echo=FALSE}
dt_zs_y13$zf_plt %>% ggplotly()
```
### Policy Evidence Graph
```{r echo=FALSE}
dt_sa_y13$res_plot$sched_plt %>% ggplotly()
```
Row
-----------------------------------------------------------------------
### Wait Times in weeks
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y13$results$pw)
```
### Wait List Size
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y13$results$wtl)
```
### Transitions per week
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y13$results$tr)
```
### Utilization
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y13$results$util)
```
Row
-----------------------------------------------------------------------
### Reschedules
```{r echo=FALSE, cache=FALSE}
kable(dt_pl_y13$results$rsc)
```
### Wait List Size by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_y13$res_plot$waitlist_plt %>% ggplotly()
```
### Reschedules by Group
```{r echo=FALSE, cache=FALSE}
dt_sa_y13$res_plot$rsc_plt %>% ggplotly()
```